home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / Foible / fsm / fsm-foible.st
Text File  |  1993-07-24  |  27KB  |  1,169 lines
  1. 'Finite state machine simulator written as a class project
  2. using Foible for CS497 REJ, fall 1990, by
  3. Kamal A. Khan <kkhan@suna0.cs.uiuc.edu>'!
  4.  
  5. BoxWithPorts subclass: #FacsBox
  6.     instanceVariableNames: 'permanentForm value active '
  7.     classVariableNames: 'SmallTextStyle '
  8.     poolDictionaries: ''
  9.     category: 'Facs'!
  10.  
  11.  
  12. !FacsBox methodsFor: 'form access'!
  13.  
  14. addInput: aValue toForm: aForm 
  15.     "display aValue on aForm and return it"
  16.  
  17.     self subclassResponsibility!
  18.  
  19. baseForm
  20.     "Return a copy of the Form representing the receiver"  
  21.  
  22.     ^permanentForm deepCopy!
  23.  
  24. createForms
  25.     "This is the method that creates the form."
  26.  
  27.     | aForm |
  28.     aForm _ self baseForm.
  29.     aForm offset: 0@0.
  30.     forms add: aForm!
  31.  
  32. inputForm
  33.     "return a copy of the receiver's form with the current input 
  34.     displayed "
  35.  
  36.     self subclassResponsibility!
  37.  
  38. inputForm: aValue
  39.     "return a copy of the receiver's form with aValue 
  40.     displayed on it"
  41.  
  42.     self subclassResponsibility!
  43.  
  44. permanentForm: aForm
  45.     "set the permanent form of the receiver to be aForm"  
  46.  
  47.     permanentForm _ aForm! !
  48.  
  49. !FacsBox methodsFor: 'accessing'!
  50.  
  51. acceptInput: aPoint 
  52.     "default method for a box to get input, if it accepts input. 
  53.     The point where the box was poked is supplied if needed."
  54.  
  55.     | oldInput newInput |
  56.     oldInput _ self value.
  57.     oldInput isNil
  58.         ifTrue: [oldInput _ '']
  59.         ifFalse: [oldInput _ oldInput first].
  60.     newInput _ FillInTheBlank request: 'Enter Input for this Box' initialAnswer: oldInput printString.
  61.     ^newInput!
  62.  
  63. links
  64.     | myLinks |
  65.     myLinks _ OrderedCollection new.
  66.     inputPorts notNil
  67.         ifTrue: [ inputPorts do: 
  68.                     [:each | each link notNil
  69.                                 ifTrue: [myLinks add: each link]]].
  70.     outputPort notNil
  71.         ifTrue: [outputPort do:
  72.                     [:each | each link notNil
  73.                                 ifTrue: [myLinks add: each link]]].
  74.     ^myLinks! !
  75.  
  76. !FacsBox methodsFor: 'port access'!
  77.  
  78. findInputPort: aPoint 
  79.     "find and return an input port that can be linked to at
  80.         aPoint, OutputStateBox can accept an infinite number of incoming links"
  81.  
  82.     | newPort result ports |
  83.  
  84.     result _ self getInputPort: aPoint.
  85.     result isNil
  86.         ifTrue: 
  87.             [ports _ inputPorts select: [:each | each boundingBox containsPoint: aPoint].
  88.             ports isEmpty
  89.                 ifTrue: [^nil]
  90.                 ifFalse: 
  91.                     [newPort _ (ports at: 1) shallowCopy.
  92.                     newPort link: nil.
  93.                     inputPorts add: newPort.
  94.                     ^newPort]]
  95.         ifFalse: [^result]!
  96.  
  97. findOutputPort: aPoint 
  98.     "find and return an output port that can be linked to at 
  99.     aPoint "
  100.  
  101.     outputPort isNil ifTrue: [^nil].
  102.     outputPort do: [:each | each link isNil ifTrue: [^each]].
  103.     ^nil!
  104.  
  105. getInputPort: aPoint 
  106.     "find and return an input port that can be linked to at aPoint"
  107.  
  108.     inputPorts isNil ifTrue: [^nil].
  109.  
  110.     "see if user hit a port right on the nose. If so give it to him."
  111.     inputPorts do: [:each | ((each boundingBox containsPoint: aPoint)
  112.             and: [each link isNil])
  113.             ifTrue: [^each]].
  114.  
  115.     "If no input port was hit, return first empty one."
  116.     inputPorts do: [:each | each link isNil ifTrue: [^each]].
  117.  
  118.     "If none available ..."
  119.     ^nil!
  120.  
  121. initInputPortsFromRectangles: rectangles 
  122.     "initialize the input ports of the receiver"
  123.  
  124.     inputPorts _ rectangles collect: [:each | (FacsInputPort new: each)
  125.                     box: self]!
  126.  
  127. initOutputPortsFromRectangles: rectangles 
  128.     "initialize the output ports of the receiver"
  129.  
  130.     outputPort _ rectangles collect: [:each | (FacsOutputPort new: each)
  131.                     box: self]! !
  132.  
  133. !FacsBox methodsFor: 'initialization'!
  134.  
  135. initializeAt: aPoint withName: aName withForm: aForm superManager: aManager
  136.     "initialize the new FoibleBox at aPoint with form aForm  "
  137.  
  138.     name isNil ifFalse: [^self error: 'Cannot reinitialize a ' , self class name].
  139.     name _ aName.
  140.     self permanentForm: aForm.
  141.     self offset: aPoint.
  142.     owner _ aManager!
  143.  
  144. initializePorts
  145.     "initialize the ports of the FoibleBox"
  146.  
  147.     self inputs: 1 outputs: 2.! !
  148.  
  149. !FacsBox methodsFor: 'interface tests'!
  150.  
  151. acceptsDataLinks: aPoint 
  152.     "Return whether I accept DataLinks  
  153.      at the user interface"
  154.  
  155.     | port | 
  156.     port _ self findInputPort: aPoint.
  157.     ^port isNil not!
  158.  
  159. canAcceptInput
  160.     "by default, boxes can't accept input"
  161.  
  162.     ^false!
  163.  
  164. givesDataLinks: aPoint 
  165.     "Return whether I give DataLinks   
  166.      at the user interface"
  167.  
  168.     | port |
  169.     port _ self findOutputPort: aPoint.
  170.     ^port isNil not! !
  171.  
  172. !FacsBox methodsFor: 'calculations'!
  173.  
  174. clearInputValues
  175.     "clear the input values from the ports"
  176.  
  177.         inputPorts do: [:each | each clear]!
  178.  
  179. endOfInput
  180.     PopUpNotifier message: 'End of input string
  181. String not accepted'.!
  182.  
  183. firstValue
  184.     "return the first value of the receiver"
  185.  
  186.     ^self value at: 1!
  187.  
  188. firstValue: aValue 
  189.     "set the first value of the receiver"
  190.  
  191.     self value at: 1 put: aValue!
  192.  
  193. getInputValues
  194.     "get the input values form the ports"
  195.  
  196.         ^inputPorts collect: [:each | each value]!
  197.  
  198. inActive
  199.     active _ false!
  200.  
  201. indicate
  202.     active _ true!
  203.  
  204. initValue: aValue 
  205.     "give the receiver an initial value"
  206.  
  207.     self value: aValue!
  208.  
  209. isActive
  210.     active isNil   ifTrue: [active _ false].
  211.      ^active!
  212.  
  213. outputResult: result 
  214.     "send the result to all ouput ports"
  215.  
  216.      self inActive. 
  217.      (1 to: outputPort size)
  218.         do: [:i | (outputPort at: i)
  219.                 token: result].!
  220.  
  221. token
  222.     "the sender, an input port, has received a new value for  
  223.     the receiver" 
  224.  
  225.     | values result |
  226.     active notNil  ifTrue: [values _ self getInputValues.
  227.                                 self clearInputValues.
  228.                                values isNil ifTrue: [^nil].
  229.                                 result _ values detect: [:each | each isKindOf: OrderedCollection] ifNone: [^nil].
  230.                                result isEmpty ifTrue: [self endOfInput. 
  231.                                                             ^nil.].
  232.                                 self outputResult: result.]!
  233.  
  234. value
  235.     "return the value of the receiver"
  236.  
  237.     ^value!
  238.  
  239. value: aValue
  240.     "set the value of the receiver"
  241.  
  242.     value _ aValue! !
  243.  
  244. !FacsBox methodsFor: 'displaying'!
  245.  
  246. displayBox
  247.     "returns boundingBox of the receiver if it displays its  
  248.     value, nil otherwise"
  249.  
  250.     ^nil!
  251.  
  252. displayValue 
  253.     "displays the receiver's current value"
  254.  
  255.     ^self subclassResponsibility! !
  256. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  257.  
  258. FacsBox class
  259.     instanceVariableNames: ''!
  260.  
  261.  
  262. !FacsBox class methodsFor: 'form access'!
  263.  
  264. iconDirectory
  265.     "return the directory that contains the icons for the Facs"
  266.  
  267.     ^FacsDirectory iconDirectory! !
  268.  
  269. !FacsBox class methodsFor: 'displaying'!
  270.  
  271. asCursor
  272.     "return an image of the receiver which can be used as a cursor"
  273.  
  274.     ^self baseForm deepCopy! !
  275.  
  276. !FacsBox class methodsFor: 'instance creation'!
  277.  
  278. offset: aPoint withName: aString withForm: aForm superManager: aManager
  279.     "create aType FoibleBox at aPoint with form aForm"
  280.  
  281.     | foibleBox |
  282.     foibleBox _ super new.
  283.     foibleBox initializeAt: aPoint withName: aString withForm: aForm superManager: aManager.
  284.     ^foibleBox! !
  285.  
  286. FacsBox subclass: #StartState
  287.     instanceVariableNames: ''
  288.     classVariableNames: ''
  289.     poolDictionaries: ''
  290.     category: 'Facs'!
  291.  
  292.  
  293. !StartState methodsFor: 'form access'!
  294.  
  295. addInput: aNumber toForm: aForm 
  296.     "display aValue on aForm and return it"
  297.     "Write the number aNumber to aForm "   
  298.     
  299.     | aNumberString aDisplayText |
  300.     aNumberString _ aNumber printString.
  301.      aDisplayText _ aNumberString asDisplayText.
  302.      aDisplayText textStyle: (TextStyle styleNamed: #icon).
  303.      aDisplayText displayOn: aForm at: 4 @ 3.
  304.     ^aForm!
  305.  
  306. inputForm
  307.     "return a copy of the receiver's form with the current input 
  308.      displayed"
  309.  
  310.     | aForm |
  311.     aForm _ self baseForm.
  312.     aForm offset: 0@0.
  313.     ^self addInput: self value toForm: aForm! !
  314.  
  315. !StartState methodsFor: 'displaying'!
  316.  
  317. displayValue
  318.     "displays the receiver's current value"
  319.  
  320.     self removeAllForms.
  321.     forms add: self inputForm! !
  322.  
  323. !StartState methodsFor: 'accessing'!
  324.  
  325. initValue: aValue 
  326.     "store the receiver's initial value"
  327.  
  328.     self value: aValue.
  329.     self displayValue!
  330.  
  331. newInputFromUser: aValue 
  332.     "inform the receiver that he has new input from the user"
  333.  
  334.     aValue size > 0
  335.         ifTrue: 
  336.             [self value: aValue.
  337.                 active _ true.
  338.             ^self boundingBox]
  339.         ifFalse: [^'State input must be a string, please try again']!
  340.  
  341. value: aValue 
  342.     "set the value of the receiver"
  343.  
  344.     value _ aValue.
  345.     self displayValue! !
  346.  
  347. !StartState methodsFor: 'calculation'!
  348.  
  349. token
  350.  
  351.     self outputResult: (value asOrderedCollection)! !
  352.  
  353. !StartState methodsFor: 'initialization'!
  354.  
  355. initializeAt: aPoint withName: aName withForm: aForm superManager: aManager
  356.     "initialize the new FoibleBox at aPoint"
  357.  
  358.     super
  359.         initializeAt: aPoint
  360.         withName: aName
  361.         withForm: aForm
  362.         superManager: aManager.
  363.     self initValue: '0'! !
  364.  
  365. !StartState methodsFor: 'interface tests'!
  366.  
  367. canAcceptInput
  368.     "input boxes accept input by default"
  369.  
  370.     ^true! !
  371.  
  372. FacsBox subclass: #DeadState
  373.     instanceVariableNames: ''
  374.     classVariableNames: ''
  375.     poolDictionaries: ''
  376.     category: 'Facs'!
  377.  
  378.  
  379. !DeadState methodsFor: 'initialization'!
  380.  
  381. initializePorts
  382.     "initialize the ports of the FoibleBox"
  383.  
  384.     self inputs: 1 outputs: 0.! !
  385.  
  386. !DeadState methodsFor: 'output'!
  387.  
  388. indicate
  389.  
  390.     PopUpNotifier message: 'DEAD STATE - Input not accepted'.! !
  391.  
  392. FacsBox subclass: #FinalState
  393.     instanceVariableNames: ''
  394.     classVariableNames: ''
  395.     poolDictionaries: ''
  396.     category: 'Facs'!
  397.  
  398.  
  399. !FinalState methodsFor: 'output'!
  400.  
  401. endOfInput
  402.     PopUpNotifier message: 'End of input string
  403. FINAL STATE - Input accepted'.! !
  404.  
  405. FacsBox subclass: #BinaryState
  406.     instanceVariableNames: ''
  407.     classVariableNames: ''
  408.     poolDictionaries: ''
  409.     category: 'Facs'!
  410.  
  411.  
  412. Port subclass: #FacsOutputPort
  413.     instanceVariableNames: ''
  414.     classVariableNames: ''
  415.     poolDictionaries: ''
  416.     category: 'Facs'!
  417.  
  418.  
  419. !FacsOutputPort methodsFor: 'calculations'!
  420.  
  421. token: aValue 
  422.     "the receiver has a new value, pass the value to its link"
  423.  
  424.     link isNil 
  425.          ifFalse: [link token: aValue]! !
  426.  
  427. ToolBenchView subclass: #FacsView
  428.     instanceVariableNames: ''
  429.     classVariableNames: ''
  430.     poolDictionaries: ''
  431.     category: 'Facs'!
  432.  
  433. ToolBenchView comment: 
  434. 'Finite state machine simulator written as a class project
  435. using Foible for CS497 REJ, fall 1990, by
  436. Kamal A. Khan <kkhan@suna0.cs.uiuc.edu>'!
  437.  
  438. !FacsView methodsFor: 'initialize'!
  439.  
  440. initializeWithModel: aFoibleProgram
  441.     "Add the two sub-views: 2 canvases (with a dummy form for now)"
  442.  
  443.     | frontView |
  444.     self model: aFoibleProgram.
  445.     frontView _ CanvasView new.
  446.     frontView model: (aFoibleProgram firstManager).
  447.     self addSubView: frontView in: (0@0 extent: 1.0@1) borderWidth: 1.
  448.     canvas _ OrderedCollection with: frontView! !
  449.  
  450. !FacsView methodsFor: 'subview access'!
  451.  
  452. canvas
  453.      ^canvas! !
  454.  
  455. !FacsView methodsFor: 'private'!
  456.  
  457. installCanvasTools
  458.     "tell my canvas what its Tools are"
  459.  
  460.     (self canvas at: 1) addTools: (OrderedCollection new
  461.         add: StateTool new;
  462.         add: TransitionTool new;
  463.         add: EditTool new;
  464.         add: DataTool new;
  465.         add: StepTool new;
  466.         yourself)!
  467.  
  468. tools
  469.     "return an OrderdCollection of the icons for the palette"
  470.  
  471.     ^(OrderedCollection new
  472.         add: StateTool icon;
  473.         add: TransitionTool icon;
  474.         add: EditTool icon;
  475.         add: DataTool icon;
  476.         add: StepTool icon;
  477.         yourself)! !
  478. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  479.  
  480. FacsView class
  481.     instanceVariableNames: ''!
  482.  
  483.  
  484. !FacsView class methodsFor: 'instance creation'!
  485.  
  486. open
  487.     "Create a new FacsManager and open a FacsView on it"
  488.     "FacsView open."
  489.  
  490.     self openOn: ((FoibleProgram with: FacsManager new) name: 'FACS')!
  491.  
  492. openProgram
  493.     "Open an existing FacsView program saved as a binary"
  494.     "FacsView openProgram." 
  495.  
  496.     ^super openProgram!
  497.  
  498. openProgram: aName 
  499.     "Open an existing FacsView program saved as a binary"
  500.     "FacsView openProgram: <aName>. "
  501.  
  502.     ^super openProgram: aName! !
  503.  
  504. FoibleLink subclass: #FacsLink
  505.     instanceVariableNames: ''
  506.     classVariableNames: ''
  507.     poolDictionaries: ''
  508.     category: 'Facs'!
  509.  
  510.  
  511. !FacsLink methodsFor: 'displaying'!
  512.  
  513. displayBox
  514.     "answers nil, indicating the receiver does not display its 
  515.     value during calculations"
  516.  
  517.     ^nil! !
  518.  
  519. !FacsLink methodsFor: 'calculations'!
  520.  
  521. initValue: aValue 
  522.     "ignore this message, it is for boxes only"
  523.  
  524.     ^self! !
  525.  
  526. !FacsLink methodsFor: 'interface tests'!
  527.  
  528. acceptsDataLinks: aPoint 
  529.     "Return whether I accept DataLinks 
  530.      at the user interface"
  531.  
  532.     ^false!
  533.  
  534. canAcceptInput
  535.     "just say no to input requests for wires"
  536.  
  537.     ^false!
  538.  
  539. canBeCopied
  540.     "do not copy links"
  541.  
  542.     ^false!
  543.  
  544. givesDataLinks: aPoint
  545.     "Return whether I give DataLinks
  546.          at the user interface"
  547.  
  548.     ^false! !
  549.  
  550. !FacsLink methodsFor: 'initialization'!
  551.  
  552. from: aSource to: aDest withPath: newPath 
  553.     "Initialize this FoibleLink linked from aSource to  
  554.     aDest, using the given newPath to make my form"
  555.  
  556.     source isNil ifFalse: [self error: 'cannot re-initialize a ' , self class name].
  557.     source _ aSource.
  558.      source addLink: self.
  559.     destination _ aDest.
  560.     destination addLink: self.
  561.     self path: newPath! !
  562. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  563.  
  564. FacsLink class
  565.     instanceVariableNames: ''!
  566.  
  567.  
  568. !FacsLink class methodsFor: 'form access'!
  569.  
  570. iconDirectory
  571.     "return the directory that contains the icons for Facs"
  572.  
  573.     ^FacsDirectory iconDirectory! !
  574.  
  575. FacsLink subclass: #ZeroLink
  576.     instanceVariableNames: ''
  577.     classVariableNames: ''
  578.     poolDictionaries: ''
  579.     category: 'Facs'!
  580.  
  581.  
  582. !ZeroLink methodsFor: 'calculations'!
  583.  
  584. token: aValue 
  585.     "the receiver has a new value, transmit only if proper type"
  586.  
  587.     | symbol newValue |
  588.      aValue isEmpty  ifTrue: [^nil].
  589.      newValue _ aValue shallowCopy.
  590.      symbol _ newValue removeFirst.
  591.       (symbol = $0)
  592.                 ifTrue: [destination token: newValue.]
  593.                 ifFalse: [^nil].! !
  594.  
  595. FacsLink subclass: #OneLink
  596.     instanceVariableNames: ''
  597.     classVariableNames: ''
  598.     poolDictionaries: ''
  599.     category: 'Facs'!
  600.  
  601.  
  602. !OneLink methodsFor: 'calculations'!
  603.  
  604. token: aValue 
  605.     "the receiver has a new value, transmit only if proper type"
  606.  
  607.     | symbol newValue |
  608.      aValue isEmpty  ifTrue: [^nil].
  609.      newValue _ aValue shallowCopy.
  610.      symbol _ (newValue removeFirst).
  611.       (symbol = $1)
  612.                 ifTrue: [destination token: newValue.]
  613.                 ifFalse: [^nil].! !
  614.  
  615. Port subclass: #FacsInputPort
  616.     instanceVariableNames: 'value '
  617.     classVariableNames: ''
  618.     poolDictionaries: ''
  619.     category: 'Facs'!
  620.  
  621.  
  622. !FacsInputPort methodsFor: 'calculations'!
  623.  
  624. token: aValue
  625.     "the sender is passing a new value for use in the receiver's box; hold value and 
  626.        notify box"
  627.  
  628.      aValue isNil ifTrue: [box endOfInput]
  629.                     ifFalse: [value _ aValue.
  630.                                  box indicate.]! !
  631.  
  632. !FacsInputPort methodsFor: 'accessing'!
  633.  
  634. clear
  635.     "clear the value of the receiver"
  636.  
  637.     value _ nil!
  638.  
  639. value
  640.     "return the value of the receiver"
  641.  
  642.     ^value! !
  643.  
  644. FoibleManager subclass: #FacsManager
  645.     instanceVariableNames: ''
  646.     classVariableNames: ''
  647.     poolDictionaries: ''
  648.     category: 'Facs'!
  649.  
  650.  
  651. !FacsManager methodsFor: 'activity'!
  652.  
  653. reset
  654.     "make all my boxes inactive"
  655.  
  656.     boxes do: [:each | (each isKindOf: FacsBox)
  657.             ifTrue: [each inActive]].!
  658.  
  659. showActive: aView
  660.     "get list of active boxes"
  661.  
  662.       | activeSet |
  663.  
  664.      activeSet _ OrderedCollection new.
  665.     boxes do: [:each | ((each isKindOf: FacsBox) & (each isActive))
  666.                           ifTrue: [activeSet add: each]].
  667.     ^activeSet! !
  668.  
  669. !FacsManager methodsFor: 'adding'!
  670.  
  671. add: aClass at: aPoint 
  672.     "add a Foible of the class aClass at aPoint"
  673.  
  674.     ^self addBox: [:name | aClass
  675.             offset: aPoint
  676.             withName: name
  677.             withForm: aClass asCursor
  678.             superManager: self]! !
  679.  
  680. !FacsManager methodsFor: 'displaying'!
  681.  
  682. displayBox
  683.     "returns the area of the manager's box that needs to be 
  684.     redrawn during calculations"
  685.  
  686.     | aBox aRectangle |
  687.     boxes do: 
  688.         [:each | 
  689.         aBox _ each displayBox.
  690.         aRectangle isNil
  691.             ifTrue: [aRectangle _ aBox]
  692.             ifFalse: [aBox isNil ifFalse: [aRectangle _ aRectangle merge: aBox]]].
  693.     ^aRectangle! !
  694.  
  695. !FacsManager methodsFor: 'accessing'!
  696.  
  697. changeValue: name to: newInput 
  698.     "Inform the Box with the given name that it has new input"
  699.  
  700.     | box |
  701.     box _ self findName: name.
  702.     box isNil ifTrue: [^nil].
  703.     ^box newInputFromUser: newInput!
  704.  
  705. lastBox
  706.     "returns the last box added to to the receiver"
  707.  
  708.     ^boxes last! !
  709.  
  710. Object subclass: #FacsDirectory
  711.     instanceVariableNames: ''
  712.     classVariableNames: ''
  713.     poolDictionaries: ''
  714.     category: 'Facs'!
  715.  
  716. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  717.  
  718. FacsDirectory class
  719.     instanceVariableNames: ''!
  720.  
  721.  
  722. !FacsDirectory class methodsFor: 'form access'!
  723.  
  724. iconDirectory
  725.     "return the directory that contains the icons for the Facs"
  726.  
  727.     ^'/Facs/icons'! !
  728.  
  729. Tool subclass: #FacsTool
  730.     instanceVariableNames: ''
  731.     classVariableNames: ''
  732.     poolDictionaries: ''
  733.     category: 'Facs'!
  734.  
  735.  
  736. !FacsTool methodsFor: 'menu messages'!
  737.  
  738. add: aClass 
  739.     "Get a point in the viewport and add a Foible of the class     
  740.           aClass there"
  741.  
  742.     | aPoint aThing  currentModel aCursor |
  743.     currentModel _ model.
  744.     aCursor _ aClass asCursor.
  745.     aPoint _ self getThingPoint: aCursor.
  746.     aPoint isNil ifTrue: [^nil].
  747.     currentModel _ self getManager: aPoint.
  748.     currentModel isNil ifTrue: [^nil].
  749.     aThing _ currentModel addBox: [:name | aClass
  750.                     offset: aPoint
  751.                     withName: name
  752.                     withForm: aCursor
  753.                     superManager: currentModel]. 
  754.     model changed: aThing!
  755.  
  756. getManager: aPoint 
  757.     "return the manager of the box at aPoint"
  758.  
  759.     | aBox |
  760.     aBox _ model find: aPoint.
  761.     aBox isNil
  762.         ifTrue: [^model]
  763.         ifFalse: [^aBox manager]! !
  764.  
  765. !FacsTool methodsFor: 'accessing'!
  766.  
  767. getView
  768.  
  769.    ^view! !
  770. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  771.  
  772. FacsTool class
  773.     instanceVariableNames: ''!
  774.  
  775.  
  776. !FacsTool class methodsFor: 'form access'!
  777.  
  778. iconDirectory
  779.     "return the directory that contains the icons for Facs"
  780.  
  781.     ^FacsDirectory iconDirectory! !
  782.  
  783. FacsTool subclass: #StepTool
  784.     instanceVariableNames: ''
  785.     classVariableNames: ''
  786.     poolDictionaries: ''
  787.     category: 'Facs'!
  788.  
  789.  
  790. !StepTool methodsFor: 'menu messages'!
  791.  
  792. redButtonActivity
  793.     "red button activity for StepTool"
  794.  
  795.     self step!
  796.  
  797. reset
  798.     "set all states inactive"
  799.  
  800.       model reset!
  801.  
  802. step
  803.     "advance the state machine one step from a particular state"
  804.  
  805.     |  newPoint aThing displaySet |
  806.     newPoint _ self getPoint: self class cursor.
  807.     newPoint isNil ifTrue: [^nil].    "User aborted"
  808.  
  809.     aThing _ model find: newPoint suchThat: [:it | it isKindOf: FacsBox].
  810.     aThing isNil ifTrue: [^nil].
  811.     aThing token.
  812.     displaySet _ model showActive: view.
  813.     displaySet isEmpty 
  814.                   ifTrue: [PopUpNotifier message: 'No valid transition 
  815. Input not accepted'.
  816.                              self reset.]
  817.                   ifFalse: [[Sensor redButtonPressed]
  818.                              whileFalse: [displaySet do: [ :each | Display flash: (self getView
  819.                                                displayTransform: each boundingBox)]]].! !
  820.  
  821. !StepTool methodsFor: 'menu setup'!
  822.  
  823. installMenu
  824.     "Install our menu"
  825.  
  826.     controller yellowButtonMenu: (PopUpMenu labels: 'Open Layout
  827.  Save Layout
  828.  Reset Automata')
  829.         yellowButtonMessages: #(open save reset)! !
  830. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  831.  
  832. StepTool class
  833.     instanceVariableNames: ''!
  834.  
  835.  
  836. !StepTool class methodsFor: 'accessing'!
  837.  
  838. cursorOffset
  839.     " return the offset of my cursor "
  840.  
  841.     ^ -8 @ -8! !
  842.  
  843. FacsTool subclass: #TransitionTool
  844.     instanceVariableNames: 'transitionType '
  845.     classVariableNames: ''
  846.     poolDictionaries: ''
  847.     category: 'Facs'!
  848.  
  849.  
  850. !TransitionTool methodsFor: 'menu setup'!
  851.  
  852. installMenu
  853.     "Install our menu"
  854.  
  855.     controller yellowButtonMenu: (PopUpMenu labels: 'Zero-transition
  856.  One-transition')
  857.         yellowButtonMessages: #(zeroTransition oneTransition )! !
  858.  
  859. !TransitionTool methodsFor: 'menu messages'!
  860.  
  861. add 
  862. "link this type of link"
  863.  
  864.     | fromThing toThing link  aProtoLink lines |
  865.  
  866.     aProtoLink _ self getPath.
  867.     aProtoLink isNil ifTrue: [^nil].
  868.     fromThing _ aProtoLink origin.
  869.     toThing _ aProtoLink destination.
  870.     lines _ aProtoLink lines.
  871.     link _fromThing box owner 
  872.                 addLink: transitionType
  873.                 from: fromThing
  874.                 to: toThing
  875.                 withPath: lines.
  876.     link isNil ifTrue: [^nil].
  877.     model changed: link.!
  878.  
  879. getPath
  880.     "Allow the user to draw the path between the two boxes   
  881.     (with no restrictions) and return the path"
  882.  
  883.     ^self
  884.         pathFrom: [:it :point | it givesDataLinks: point]
  885.         to: [:it :point | it acceptsDataLinks: point]
  886.         width: (self transition) width
  887.         both: [:a :b | a box = a box]     "dummy test"!
  888.  
  889. oneTransition
  890.     "assigns the current transition type"
  891.  
  892.     transitionType _ OneLink!
  893.  
  894. redButtonActivity
  895.     "red button activity for TransitionTool"
  896.  
  897.     self add!
  898.  
  899. zeroTransition
  900.     "assigns the current transition type"
  901.  
  902.     transitionType _ ZeroLink! !
  903.  
  904. !TransitionTool methodsFor: 'accessing'!
  905.  
  906. transition
  907.  
  908.     transitionType isNil ifTrue:[transitionType _ ZeroLink].
  909.      ^transitionType! !
  910. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  911.  
  912. TransitionTool class
  913.     instanceVariableNames: ''!
  914.  
  915.  
  916. !TransitionTool class methodsFor: 'accessing'!
  917.  
  918. cursorOffset
  919.     "Return the offset of my cursor"
  920.  
  921.     ^-8 @ -8! !
  922.  
  923. FacsTool subclass: #StateTool
  924.     instanceVariableNames: ''
  925.     classVariableNames: ''
  926.     poolDictionaries: ''
  927.     category: 'Facs'!
  928.  
  929.  
  930. !StateTool methodsFor: 'menu messages'!
  931.  
  932. binaryState
  933.     self add: BinaryState!
  934.  
  935. deadState
  936.     self add: DeadState!
  937.  
  938. finalState
  939.     self add: FinalState!
  940.  
  941. startState
  942.       self add: StartState! !
  943.  
  944. !StateTool methodsFor: 'menu setup'!
  945.  
  946. installMenu
  947.     "Install my menu"
  948.  
  949.     controller yellowButtonMenu: (PopUpMenu labels: 'Start-State
  950. Binary-State
  951. Final-State
  952. Dead-State' lines: #(4 ))
  953.         yellowButtonMessages: #(startState binaryState finalState deadState )! !
  954. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  955.  
  956. StateTool class
  957.     instanceVariableNames: ''!
  958.  
  959.  
  960. !StateTool class methodsFor: 'accessing'!
  961.  
  962. cursorOffset
  963.     "Return the offset of my cursor"
  964.  
  965.     ^-8 @ -8! !
  966.  
  967. FacsTool subclass: #EditTool
  968.     instanceVariableNames: ''
  969.     classVariableNames: ''
  970.     poolDictionaries: ''
  971.     category: 'Facs'!
  972. EditTool comment:
  973. 'EditTool is the concrete class for moving, deleting, and copying Boxes.'!
  974.  
  975.  
  976. !EditTool methodsFor: 'menu messages'!
  977.  
  978. copy
  979.     "Find an object and copy it"
  980.  
  981.     | oldThing newPoint newImage currentModel |
  982.     newPoint _ self getPoint: self class moverCursor.
  983.     currentModel _ model.
  984.     newPoint isNil ifTrue: [^nil].
  985.     "User aborted"
  986.     oldThing _ model find: newPoint suchThat: [:it | it canBeCopied].
  987.     oldThing isNil ifTrue: [^false].
  988.     Sensor cursorPoint: (view displayTransform: oldThing offset).
  989.     newImage _ oldThing class asCursor.
  990.     newPoint _ self getThingPoint: newImage.
  991.     newPoint isNil ifTrue: [^nil].
  992.     currentModel _ self getManager: newPoint.
  993.     currentModel isNil ifTrue: [^nil].
  994.     "The thing already exists, abort"
  995.     Cursor wait show.
  996.     oldThing _ currentModel addBox: [:name | oldThing class
  997.                     offset: newPoint
  998.                     withName: name
  999.                     withForm: newImage
  1000.                         superManager: currentModel].
  1001.     model changed: oldThing.
  1002.     model cursor show.!
  1003.  
  1004. delete
  1005.     "Find an object and remove it from list, return nil if not found"
  1006.  
  1007.     | aPoint aThing aRectangle |
  1008.     aPoint _ self getPoint: self class killCursor.
  1009.     aPoint isNil ifTrue: [^nil].
  1010.     "User aborted"
  1011.     aThing _ model find: aPoint suchThat: [:it | it canBeDeleted].
  1012.     aThing isNil ifTrue: [^nil].
  1013.     "No such object"
  1014.     (BinaryChoice message: 'Really delete' , aThing name , '?')
  1015.         ifFalse: [^nil].
  1016.     aRectangle _ aThing owner remove: aThing.
  1017.     model changed: aRectangle.!
  1018.  
  1019. move
  1020.     "Find an object and move it"
  1021.  
  1022.     | oldThing newPoint aRectangle currentModel aBox |
  1023.     newPoint _ self getPoint: self class cursor.
  1024.     newPoint isNil ifTrue: [^nil].    "User aborted"
  1025.  
  1026.     oldThing _ model find: newPoint suchThat: [:it | it canMoveIndependently].
  1027.     oldThing isNil ifTrue: [^nil].
  1028.     (oldThing isKindOf: self defaultLinkClass)
  1029.         ifTrue: [aRectangle_self moveLine: oldThing 
  1030.                                     point: newPoint].
  1031.     (oldThing isKindOf: FoibleBox)
  1032.         ifTrue: [Sensor cursorPoint: (view displayTransform: oldThing offset).
  1033.                 newPoint _ self getThingPoint: oldThing ghostForm.
  1034.                 newPoint isNil ifTrue: [^nil].
  1035.                 currentModel _ model.
  1036.                 aBox _ model find: newPoint suchThat: [:it | it isKindOf: FoibleBox].
  1037.                 aBox notNil
  1038.                         ifTrue: [aBox = oldThing
  1039.                             ifTrue: [currentModel _ aBox owner]
  1040.                             ifFalse: [aBox manager notNil
  1041.                                 ifTrue: [currentModel _ aBox manager]
  1042.                                 ifFalse: [currentModel _ aBox owner]].
  1043.                             oldThing manager notNil
  1044.                                 ifTrue: [(aBox inside: oldThing manager)
  1045.                                     ifTrue: [currentModel _ oldThing owner]]  ].
  1046.                 Cursor wait show. 
  1047.                 aRectangle _ currentModel
  1048.                                         moveBox: oldThing
  1049.                                         byBlock: [:box | box offset: newPoint]].
  1050.     aRectangle notNil
  1051.         ifTrue: [model changed: aRectangle].
  1052.     model cursor show!
  1053.  
  1054. redButtonActivity
  1055.     self move! !
  1056.  
  1057. !EditTool methodsFor: 'menu setup'!
  1058.  
  1059. installMenu
  1060.     "Install our menu"
  1061.  
  1062.     controller yellowButtonMenu: (PopUpMenu labels: 'Delete state
  1063.  Copy state')
  1064.         yellowButtonMessages: #(delete copy )! !
  1065. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1066.  
  1067. EditTool class
  1068.     instanceVariableNames: 'moverCursor killCursor '!
  1069.  
  1070.  
  1071. !EditTool class methodsFor: 'class initialization'!
  1072.  
  1073. initializeForms
  1074.     " send this class method when the form for my icon or cursor has been changed "
  1075.     " <class name> initializeForms  "
  1076.  
  1077.     icon _ self getIcon.
  1078.     killCursor _ (self getCursor: 'Kill.cur') offset: -8@-8.
  1079.     moverCursor _ (self getCursor: 'Mover.cur') offset: -7@-7.
  1080.     toolCursor _ self getCursor offset: self cursorOffset.! !
  1081.  
  1082. !EditTool class methodsFor: 'accessing'!
  1083.  
  1084. cursorOffset
  1085.     "Return the offset of my cursor"
  1086.  
  1087.     ^ -8 @ -8!
  1088.  
  1089. killCursor
  1090.  
  1091.     killCursor isNil ifTrue: [killCursor _ (self getCursor: 'Kill.cur') offset: -8@-8].
  1092.     ^killCursor!
  1093.  
  1094. moverCursor
  1095.  
  1096.     moverCursor isNil ifTrue: [moverCursor _ (self getCursor: 'Mover.cur') offset: -8@-8].
  1097.     ^moverCursor! !
  1098.  
  1099. FacsTool subclass: #DataTool
  1100.     instanceVariableNames: ''
  1101.     classVariableNames: ''
  1102.     poolDictionaries: ''
  1103.     category: 'Facs'!
  1104.  
  1105.  
  1106. !DataTool methodsFor: 'private'!
  1107.  
  1108. getPoint: aCursor
  1109.  
  1110.     "Get a point in the viewport and return its value, nil if left the viewport"
  1111.  
  1112.     | aPoint |
  1113.     aCursor show.
  1114.     [ Sensor noButtonPressed & controller isControlActive ]
  1115.             whileTrue: [aPoint _ Sensor cursorPoint].
  1116.  
  1117.     model cursor show.
  1118.     controller isControlActive ifFalse: [^nil].
  1119.     ^(view inverseDisplayTransform: (Sensor waitButton)) rounded! !
  1120.  
  1121. !DataTool methodsFor: 'menu messages'!
  1122.  
  1123. change
  1124.     "give new input to the given FoibleBox"
  1125.  
  1126.     | aThing aPoint aRectangle newModel thingName newInput |
  1127.     aPoint _ self getPoint: Cursor currentCursor.
  1128.     aPoint isNil ifTrue: [^nil].
  1129.     aThing _ model find: aPoint.
  1130.     aThing isNil ifTrue: [^nil].
  1131.     newModel _ aThing owner. 
  1132.     thingName _ aThing name.
  1133.  
  1134.     aThing canAcceptInput
  1135.         ifTrue: 
  1136.             [newInput _ aThing acceptInput: aPoint - aThing offset.
  1137.             aRectangle _ newModel changeValue: thingName to: newInput.
  1138.             aRectangle class == String
  1139.                 ifTrue: [PopUpNotifier message: aRectangle]
  1140.                 ifFalse: 
  1141.                     [model changed: #value with: aRectangle]]!
  1142.  
  1143. redButtonActivity
  1144.     "red button activity for WiringLinkTool"
  1145.  
  1146.     self change! !
  1147.  
  1148. !DataTool methodsFor: 'menu setup'!
  1149.  
  1150. installMenu "install our menu"
  1151.  
  1152.     controller yellowButtonMenu: nil
  1153.         yellowButtonMessages: nil! !
  1154. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1155.  
  1156. DataTool class
  1157.     instanceVariableNames: ''!
  1158.  
  1159.  
  1160. !DataTool class methodsFor: 'accessing'!
  1161.  
  1162. cursorOffset
  1163.     " return the offset of my cursor "
  1164.  
  1165.     ^ -8 @ -8! !
  1166.  
  1167.  
  1168.  
  1169.